home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Comms & Internet / HTML and CSS modes / HTML and CSS Modes / htmlUtils.tcl < prev   
Text File  |  1999-04-24  |  66KB  |  2,186 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlUtils.tcl"
  6.  #                                    created: 96-09-01 13.01.43 
  7.  #                                last update: 99-04-24 13.16.33 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jlinde@telia.com>
  10.  #     www: <http://www.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.4
  13.  # 
  14.  # Copyright 1996-1999 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc htmlUtils.tcl {} {}
  25.  
  26. #
  27. # Mark file
  28. #
  29. proc HTML::parseFuncs {} {
  30.     return [htmlMarkFile2 0]
  31. }
  32.  
  33. proc HTML::MarkFile {} {
  34.     htmlMarkFile2 1
  35.     message "Marks set."
  36. }
  37.  
  38. proc htmlMarkFile2 {markfile} {
  39.     set pos 0
  40.     set exp {<[Hh][1-6][^>]*>}
  41.     set exp2 {</[Hh][1-6]>}
  42.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp $pos} rs] && 
  43.     ![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp2 [lindex $rs 1]} res]} {
  44.         set start [lindex $rs 0]
  45.         set end [lindex $res 1]
  46.         set text [getText $start $end]
  47.         # Remove tabs and returns from text.
  48.         regsub -all "\[\t\r\]+" $text " " text
  49.         # remove all tags from text
  50.         set headtext [htmlTagStrip $text]
  51.         # Set mark only on one line.
  52.         if {$end > [nextLineStart $start]} {
  53.             set end [expr [nextLineStart $start] - 1]
  54.         }
  55.         
  56.         set indlevel [getText [expr $start + 2] [expr $start + 3]]
  57.  
  58.         if {$indlevel > 0 && $indlevel < 7} {
  59.             set lab [string range "       " 2 $indlevel]
  60.             append lab $lab $indlevel " " $headtext
  61.             # Cut the menu item if it's longer than 30 letters, not to make it too long.
  62.             if {[string length $lab] > 30} {
  63.                 set lab "[string range $lab 0 29]…"
  64.             }
  65.             if {$markfile} {
  66.                 setNamedMark $lab $start $start $end
  67.             } else {
  68.                 lappend parse $lab [lineStart $start]
  69.             }
  70.         }
  71.         set pos $end
  72.     }
  73.     if {!$markfile} {return $parse}
  74. }
  75.  
  76.  
  77. #
  78. # return positions of tags of including elements, as a list of 5 elements --
  79. # openstart openend closestart closeend elementname.
  80. # Elements without a closing tag are ignored.
  81. # args: point to start search backward from; point which must be enclosed
  82. #
  83. # if any problem, return just {0}
  84. #
  85. proc htmlGetContainer {curPos inclPos} {
  86.  
  87.     set startPos $curPos
  88.     set startPos2 $inclPos
  89.     set searchFinished 0
  90.     message "Searching for enclosing tags…"
  91.     while {!$searchFinished} {
  92.         # find first tag
  93.         set isStartTag 0
  94.         while {!$isStartTag} {
  95.             if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $startPos} res]} {
  96.                 message ""
  97.                 return {0}
  98.             }
  99.             set tag1start [lindex $res 0]
  100.             set tag1end   [lindex $res 1]
  101.             # get element name
  102.             if {![regexp {<([^ \t\r]+).*>} [getText $tag1start $tag1end] tmp tag]} {
  103.                 message ""
  104.                 return {0}
  105.             }
  106.             # is this a closing tag?
  107.             if {[string index $tag 0] != "/"} { set isStartTag 1}
  108.             set startPos [expr $tag1start - 1]
  109.         }
  110.         # find closing tag
  111.         set res [htmlGetClosing $tag $tag1end]
  112.         
  113.         set tag2start [lindex $res 0]
  114.         set tag2end   [lindex $res 1]
  115.         # If container enclosed along with us, or there is no closing tag,
  116.         # continue searching.
  117.         if {![llength $res] || $tag2end < $inclPos} {
  118.             set startPos [expr $tag1start - 1]
  119.         } else {
  120.             set Container "$tag1start $tag1end $tag2start $tag2end" 
  121.             set searchFinished 1
  122.         }
  123.     }
  124.     
  125.     message ""
  126.     return [concat $Container [string toupper $tag]]
  127. }
  128.  
  129.  
  130. #
  131. # return position an opening tag if the first element to the left
  132. # of startPos is an element with only an opening tag, as a list of 3 elements --
  133. # openstart openend elementname.
  134. #
  135. # if any problem, return empty string
  136. #
  137.  
  138. proc htmlGetOpening {startPos} {
  139.     
  140.     while {1} {
  141.         if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $startPos} res]} {
  142.             return
  143.         }
  144.         set tag1start [lindex $res 0]
  145.         set tag1end   [lindex $res 1]
  146.         # get element name
  147.         if {![regexp {<([^ \t\r]+).*>} [getText $tag1start $tag1end] tmp tag]} {
  148.             return
  149.         }
  150.         # is this a closing tag?
  151.         if {[string index $tag 0] == "/"} {return}
  152.         # comment?
  153.         if {[string range $tag 0 2] != "!--"} {break}
  154.         set startPos [expr $tag1start - 1]
  155.     }
  156.     
  157.     # find closing tag
  158.     set res [htmlGetClosing $tag $tag1end]
  159.     
  160.     if {![llength $res] } {
  161.         return "$tag1start $tag1end [string toupper $tag]"
  162.     } else {
  163.         return
  164.     }
  165.     
  166. }
  167.  
  168. proc htmlGetClosing {tag sPos} {
  169.     set x </${tag}>
  170.     set sPos2 $sPos
  171.     while {1} {
  172.         set res [search -s -f 1 -r 1 -i 1 -m 0 -n $x $sPos]
  173.         # Found any closing tag.
  174.         if {![llength $res]} {break}
  175.         # Look for another opening tag of the same element.
  176.         set y "<${tag}(\[ \\t\\r\]+|>)"
  177.         set res2 [search -s -f 1 -r 1 -i 1 -m 0 -n $y $sPos2]
  178.         # Is it further away than the closing tag.
  179.         if {![llength $res2] || [lindex $res2 0] > [lindex $res 0]} {break}
  180.         # If not, find the next closing tag.
  181.         set sPos [lindex $res 1]
  182.         set sPos2 [lindex $res2 1]
  183.     }
  184.     return $res
  185. }
  186.  
  187. # Change choice of an attribute with pre-defined choices.
  188. proc htmlChangeChoice {} {
  189.     set pos [expr [getPos] - 1]
  190.     if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $pos} res] ||
  191.     [lindex $res 1] < $pos || 
  192.     ![regexp {<([^ \t\r>]+)} [eval getText $res] tmp tag] ||
  193.     [catch {search -s -f 0 -r 1 -i 0 -m 0 {[ \t\r]+[^=]+=\"?[^\" \t\r>]*\"?} $pos} res1] ||
  194.     [lindex $res1 1] < $pos ||
  195.     ![regexp {([^=]+=)((\"[^\" \t\r]*\")|([^\" \t\r>]*))} [eval getText $res1] tmp attr choice]} {
  196.         beep
  197.         message "Current position is not at an attribute with choices."
  198.         return
  199.     }
  200.     set pos0 [expr [lindex $res1 0] + [string length $attr]]
  201.     set pos1 [expr $pos0 + [string length $choice]]
  202.     set choice [string trim $choice \"]
  203.     set tag [string toupper $tag]
  204.     if {$tag == "INPUT"} {
  205.         if {![regexp -nocase {type=(([^\" \t\r>]+)|(\"[^\" \t\r]+\"))} [eval getText $res] tmp tag]} {
  206.             beep
  207.             message "Current position is not at an attribute with choices."
  208.             return
  209.         }
  210.         set tag [string trim [string toupper $tag] \"]
  211.     }
  212.     if {$tag == "LI"} {
  213.         set ltype [htmlFindList]
  214.         if {$ltype == "UL"} {
  215.             set tag "LI IN UL"
  216.         } elseif {$ltype == "OL"} {
  217.             set tag "LI IN OL"
  218.         }            
  219.     }
  220.     set attr [string trim [string toupper $attr]]
  221.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set choice [string toupper $choice]}
  222.     set choices [htmlGetChoices $tag]
  223.     foreach c $choices {
  224.         if {[string match "${attr}*" $c]} {
  225.             lappend matches [string range $c [string length $attr] end]
  226.         }    
  227.     }
  228.     if {![info exists matches]} {
  229.         beep
  230.         message "Current position is not at an attribute with choices."
  231.         return
  232.     }
  233.     if {[set this [lsearch -exact $matches $choice]] < 0} {set this 0}
  234.     incr this
  235.     if {$this == [llength $matches]} {set this 0}
  236.     set this [lindex $matches $this]
  237.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set this [htmlSetCase $this]}
  238.     replaceText $pos0 $pos1 "\"$this\""
  239.     goto [expr ($pos0 + [string length $this] > $pos) ? $pos + 1 : $pos0 + [string length $this] + 1]
  240. }
  241.  
  242.  
  243. # Save current window and uploads it to the ftp server.
  244. proc htmlSavetoFTPServer {} {
  245.     global htmlPasswords HTMLmodeVars ftpSig
  246.  
  247.     set win [stripNameCount [lindex [winNames -f] 0]]
  248.     if {[set this [htmlThisFilePath 4]] == ""} {return}
  249.     set home [lindex $this 3]
  250.     if {$home == "" && [lindex $this 0] != "file:///"} {set home [htmlInWhichHomePage "[lindex $this 0][lindex $this 1]"]}
  251.     if {$home == "" || [lindex $this 4] == "4"} {
  252.         alertnote "Current window is not in a home page folder."
  253.         return
  254.     }
  255.     
  256.     foreach f $HTMLmodeVars(FTPservers) {
  257.         if {[lindex $f 0] == $home} {set serv $f}
  258.     }
  259.     if {![info exists serv]} {
  260.         alertnote "No ftp server specified for this home page."
  261.         htmlHomePages "[lindex $this 0][lindex $this 1]"
  262.         return
  263.     }
  264.     
  265.     if {[lindex $serv 3] != ""} {set htmlPasswords($home) [lindex $serv 3]}
  266.     if {![info exists htmlPasswords($home)]} {
  267.         if {![catch {htmlGetPassword [lindex $serv 1]} pword]} {
  268.             set htmlPasswords($home) $pword
  269.         } else {
  270.             return
  271.         }
  272.     }
  273.     save
  274.     set path [lindex $this 2]
  275.     if {[lindex $serv 4] != ""} {set path [join [list [lindex $serv 4] $path] /]}
  276.     if {![info exists ftpSig] || ![app::isRunning $ftpSig] && [catch {app::launchBack $ftpSig}]} {
  277.         getApplSig "Please locate your ftp application" ftpSig
  278.         app::launchBack $ftpSig
  279.     }
  280.     currentReplyHandler htmlHandleReply
  281.     switch $ftpSig {
  282.         Arch -
  283.         FTCh {AEBuild -r -q -t 30000 '$ftpSig' Arch Stor ---- [makeAlis $win] FTPh "“[lindex $serv 1]”" FTPc "“$path”" ArGU "“[lindex $serv 2]”" ArGp "“$htmlPasswords($home)”"}
  284.         Woof {
  285.             set path [string range $path 0 [expr [string last / $path] - 1]]
  286.             AEBuild -r -q -t 30000 '$ftpSig' PURL PURL ---- [makeAlis $win] dest "“ftp://[lindex $serv 2]:$htmlPasswords($home)@[lindex $serv 1]/$path”"
  287.         }
  288.     }
  289. }
  290.  
  291. proc htmlHandleReply {reply} {
  292.     global htmlPasswords
  293.     set ans [string range $reply 11 end]
  294.     if {[regexp {^errs:“([^”]+)”} $ans dum err]} {
  295.         # Fetch error
  296.         if {[regexp {Error: (.*)} $err dum err2]} {set err $err2}
  297.         alertnote "Ftp error: $err"
  298.         unset htmlPasswords
  299.     } elseif {[regexp {^'----':(-?[0-9]*)} $ans dum err]} {
  300.         if {$err != "0"} {
  301.             # Anarchie error.
  302.             message "Ftp error."
  303.             unset htmlPasswords
  304.         } else {
  305.             message "Document uploaded to ftp server."
  306.         }
  307.     } elseif {$ans == "\\\}"} {
  308.         message "Document uploaded to ftp server."
  309.     } else {
  310.         return 0
  311.     }
  312.     return 1
  313. }
  314.  
  315.  
  316. proc htmlGetPassword {host} {
  317.     set values [dialog -w 300 -h 90 -t "Password for $host:" 10 20 290 30 \
  318.         -e "" 10 40 290 42 -b OK 20 60 85 80 -b Cancel 105 60 170 80]
  319.     if {[lindex $values 2]} {error "Cancel"}
  320.     return [string trim [lindex $values 0]]
  321. }
  322.  
  323. proc htmlForgetPasswords {} {
  324.     global htmlPasswords
  325.     message "Passwords forgotten."
  326.     unset htmlPasswords
  327. }
  328.  
  329. # Calculate the total size of a document including images etc.
  330. proc htmlDocumentSize {} {
  331.     # Get path to this window.
  332.     if {[set thisURL [htmlThisFilePath 3]] == ""} {return}
  333.     set exp1 "<!--|\[ \\t\\n\\r\]+(SRC=|LOWSRC=|DYNSRC=|BACKGROUND=)(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  334.     set exp2 {/\*|[ \t\r\n]+(url)\(\"?([^\"\)]+)\"?\)}
  335.     set commStart1 "<!--"
  336.     set commEnd1 "-->"
  337.     set commStart2 {/*}
  338.     set commEnd2 {*/}
  339.     set size 0
  340.     set counted {}
  341.     set external 0
  342.     set notfound 0
  343.     for {set i 1} {$i < 3} {incr i} {
  344.         set pos 0
  345.         set exp [set exp$i]
  346.         set commStart [set commStart$i]
  347.         set commEnd [set commEnd$i]
  348.         while {![catch {search -s -f 1 -i 1 -m 0 -r 1 $exp $pos} res]} {
  349.             set restxt [eval getText $res]
  350.             # Comment?
  351.             if {$restxt == $commStart} {
  352.                 if {![catch {search -s -f 1 -m 0 -i 0 -r 0 -- $commEnd [lindex $res 1]} res]} {
  353.                     set pos [lindex $res 1]
  354.                     continue
  355.                 } else {
  356.                     break
  357.                 }
  358.             }
  359.             # Get path to link.
  360.             regexp -nocase $exp $restxt dum1 dum2 linkTo
  361.             set linkTo [htmlURLunEscape [string trim $linkTo \"]]
  362.             if {![catch {lindex [htmlPathToFile [lindex $thisURL 0] [lindex $thisURL 1] [lindex $thisURL 2] [lindex $thisURL 3] $linkTo] 0} linkToPath]} {
  363.                 if {[file exists $linkToPath] && ![file isdirectory $linkToPath]} {
  364.                     if {[lsearch -exact $counted $linkToPath] < 0} {
  365.                         getFileInfo $linkToPath arr
  366.                         incr size $arr(datalen)
  367.                         lappend counted $linkToPath
  368.                     }
  369.                 } else {
  370.                     set notfound 1
  371.                 }
  372.             } else {
  373.                 set external 1
  374.             }
  375.             set pos [lindex $res 1]
  376.         }
  377.     }
  378.     incr size [maxPos]
  379.     if {$size > 1000} {
  380.         set size "[expr $size /1024] kB"
  381.     } else {
  382.         append size " bytes"
  383.     }
  384.     set txt "Total size: $size."
  385.     if {$notfound} {append etxt "Some files not found. "}
  386.     if {$external} {append etxt "External sources excluded."}
  387.     if {$notfound || $external} {append txt " ([string trim $etxt])"}
  388.     alertnote $txt
  389. }
  390.  
  391. #
  392. # dividing line
  393. #
  394. proc htmlCommentLine {} {
  395.     global HTMLmodeVars fillColumn
  396.     set wordWrap    $HTMLmodeVars(wordWrap)
  397.     set comStr    [htmlCommentStrings]
  398.     set prefixString [lindex $comStr 0]
  399.     set suffixString [lindex $comStr 1]
  400.     set s "===================================================================================="
  401.     set l [expr [string length $prefixString] + [string length $suffixString]]
  402.     if {$wordWrap} { 
  403.         set l [expr $fillColumn - $l - 1] 
  404.     } else {
  405.         set l [expr 75 - $l - 1]
  406.     }
  407.     insertText [htmlOpenCR [htmlFindNextIndent]] $prefixString [string range $s 0 $l] $suffixString "\r"
  408. }
  409.  
  410.  
  411. #===============================================================================
  412. # Character translation
  413. #===============================================================================
  414.  
  415. #
  416. # Converting  characters to HTML entities.
  417. #
  418. # 1 = < > &
  419. # 0 = áé etc.
  420. proc htmlCharacterstohtml {ltgtamp} {
  421.     global htmlSpecialCharacter 
  422.     global htmlSpecialCapCharacter htmlSpecialSymbCharacter
  423.     
  424.     if {$ltgtamp} {
  425.         set charlist {& < >}
  426.     } else {    
  427.         foreach a [array names htmlSpecialCharacter] {
  428.             if { $a != "eth" && $a != "thorn" && $a != "y´"} { 
  429.                 lappend charlist $a
  430.             }
  431.         }
  432.         
  433.         foreach a [array names htmlSpecialCapCharacter] {
  434.             if {$a != "ETH" && $a != "THORN" && $a != "Y´"} { 
  435.                 lappend charlist $a
  436.             }
  437.         }
  438.         lappend charlist ¡ ¿
  439.     }
  440.     
  441.     set subs1 0;  set lett 0
  442.     set pos [getPos]
  443.     if {[set start $pos] == [set end [selEnd]]} {
  444.         if {$ltgtamp && \
  445.         [askyesno "There is no selection. Really translate < > & in whole document?"] == "no"} {return}
  446.         set messageString "document"
  447.         set start 0
  448.         set end [maxPos]
  449.         set isDoc 1
  450.     } else {
  451.         set messageString "selection"
  452.         set isDoc 0
  453.     }
  454.     message "Translating…"
  455.     set text [getText $start $end]
  456.     set tmp $text
  457.     set upos $pos
  458.     set st $start
  459.     if {!$ltgtamp} {
  460.         while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $tmp str]} {
  461.             set sv [string range $tmp [lindex $str 0] [lindex $str 1]]
  462.             if {[expr $st + [lindex $str 1]] < $upos} {
  463.                 incr pos [expr 17 - [string length $sv]]
  464.             } elseif {[expr $st + [lindex $str 0]] < $upos} {
  465.                 incr pos [expr $st + [lindex $str 0] - $upos]
  466.             }
  467.             lappend savestr $sv
  468.             set tmp [string range $tmp [lindex $str 1] end]
  469.             incr st [lindex $str 1]
  470.         }
  471.         regsub -all -nocase "<!--\[ \t\r\]+#(INCLUDE|LASTMODIFIED)\[ \t\r\]+\[^>\]+>" $text {<!-- #INCLUDE -->} text
  472.     }
  473.     if {$isDoc} {    
  474.         set text1 [string range $text 0 [expr $pos - $start - 1]]
  475.         set text2 [string range $text [expr $pos - $start] end]
  476.     } else {
  477.         set text1 $text
  478.     }
  479.     foreach char $charlist {
  480.  
  481.         if {[info exists htmlSpecialCharacter($char)]} {
  482.             set rtext "\\&$htmlSpecialCharacter($char);"
  483.         } elseif {[info exists htmlSpecialCapCharacter($char)]} {
  484.             set rtext "\\&$htmlSpecialCapCharacter($char);"
  485.         } elseif {$char == "¡"} {
  486.             set rtext "\\¡"
  487.         } elseif {$char == "¿"} {
  488.             set rtext "\\¿"
  489.         } elseif {$char == ">"} {
  490.             set rtext "\\>" 
  491.         } elseif {$char == "<"} {
  492.             set rtext "\\<"
  493.         } elseif {$char == "&"} {
  494.             set rtext "\\&"
  495.         }
  496.         
  497.         set subNum [regsub -all $char $text1 [set rtext] text1]
  498.         incr subs1 [expr $subNum * ([string length $rtext] - 2)]
  499.         incr lett $subNum
  500.         if {$isDoc} {
  501.             incr lett [regsub -all $char $text2 [set rtext] text2]
  502.         }
  503.         
  504.     }
  505.     set text $text1
  506.     if {$isDoc} {append text $text2}
  507.     if {$lett} {
  508.         if {[info exists savestr]} {
  509.             set i 0
  510.             set tmp ""
  511.             while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $text str]} {
  512.                 append tmp [string range $text 0 [expr [lindex $str 0] - 1]]
  513.                 append tmp [lindex $savestr $i]
  514.                 set text [string range $text [expr [lindex $str 1] + 1] end]
  515.                 incr i
  516.             }
  517.             set text "$tmp$text"
  518.         }
  519.         replaceText $start $end $text
  520.         if {$isDoc} {
  521.             goto [expr $upos + $subs1]
  522.         } else {
  523.             set end [getPos]
  524.             select $start $end
  525.         }
  526.     }
  527.     message "$lett characters translated in $messageString."
  528. }
  529.  
  530.  
  531.  
  532. #
  533. # Converting HTML entities to characters.
  534. #
  535. # 1 = < > &
  536. # 0 = áé etc.
  537. proc htmltoCharacters {ltgtamp} {
  538.     global htmlCharacterSpecial  
  539.     global htmlCapCharacterSpecial 
  540.     
  541.     message "Translating…"
  542.     
  543.     if {$ltgtamp} {
  544.         set entitylist {"&" "<" ">"} 
  545.     } else {
  546.         foreach a [array names htmlCharacterSpecial] {
  547.             if { $a != "eth" && $a != "thorn" && $a != "y´"} { 
  548.                 lappend entitylist "&$a;"
  549.             }
  550.         }
  551.         
  552.         foreach a [array names htmlCapCharacterSpecial] {
  553.             if {$a != "ETH" && $a != "THORN" && $a != "Y´"} { 
  554.                 lappend entitylist "&$a;"
  555.             }
  556.         }
  557.         # ¡ ¿
  558.         lappend entitylist "¡" "¿"
  559.     }
  560.     set subs1 0;  set lett 0
  561.     set pos [getPos]
  562.     if {[set start $pos] == [set end [selEnd]]} {
  563.         # Move position to linestart to make sure no letter is split.
  564.         set pos [lineStart $pos]
  565.         set messageString "document"
  566.         set start 0
  567.         set end [maxPos]
  568.         set isDoc 1
  569.     } else {
  570.         set messageString "selection"
  571.         set isDoc 0
  572.     }
  573.  
  574.     set text [getText $start $end]
  575.     set tmp $text
  576.     set upos $pos
  577.     set st $start
  578.     if {!$ltgtamp} {
  579.         while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $tmp str]} {
  580.             set sv [string range $tmp [lindex $str 0] [lindex $str 1]]
  581.             if {[expr $st + [lindex $str 1]] < $upos} {
  582.                 incr pos [expr 17 - [string length $sv]]
  583.             } elseif {[expr $st + [lindex $str 0]] < $upos} {
  584.                 incr pos [expr $st + [lindex $str 0] - $upos]
  585.             }
  586.             lappend savestr $sv
  587.             set tmp [string range $tmp [lindex $str 1] end]
  588.             incr st [lindex $str 1]
  589.         }
  590.         regsub -all -nocase "<!--\[ \t\r\]+#(INCLUDE|LASTMODIFIED)\[ \t\r\]+\[^>\]+>" $text {<!-- #INCLUDE -->} text
  591.     }
  592.     if {$isDoc} {
  593.         set text1 [string range $text 0 [expr $pos - $start - 1]]
  594.         set text2 [string range $text [expr $pos - $start] end]
  595.     } else {
  596.         set text1 $text
  597.     }        
  598.     foreach char $entitylist {
  599.         set schar [string range $char 1 [expr [string length $char] - 2]]
  600.         if {[info exists htmlCharacterSpecial($schar)]} {
  601.             set rtext "$htmlCharacterSpecial($schar)"
  602.         } elseif {[info exists htmlCapCharacterSpecial($schar)]} {
  603.             set rtext "$htmlCapCharacterSpecial($schar)"
  604.         } elseif {$schar == "#161"} {
  605.             set rtext ¡
  606.         } elseif {$schar == "#191"} {
  607.             set rtext ¿
  608.         } elseif {$schar == "amp"} {
  609.             set rtext "\\&"
  610.         } elseif {$schar == "lt"} {
  611.             set rtext "<"
  612.         } elseif {$schar == "gt"} {
  613.             set rtext ">"
  614.         }
  615.         
  616.         set subNum [regsub -all $char $text1 $rtext text1]
  617.         incr subs1 [expr $subNum * ([string length $char] - 1)]
  618.         incr lett $subNum
  619.         if {$isDoc} {
  620.             incr lett [regsub -all $char $text2 $rtext text2]
  621.         }
  622.         
  623.     }
  624.     set text $text1
  625.     if {$isDoc} {append text $text2}
  626.     if {$lett} {
  627.         if {[info exists savestr]} {
  628.             set i 0
  629.             set tmp ""
  630.             while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $text str]} {
  631.                 append tmp [string range $text 0 [expr [lindex $str 0] - 1]]
  632.                 append tmp [lindex $savestr $i]
  633.                 set text [string range $text [expr [lindex $str 1] + 1] end]
  634.                 incr i
  635.             }
  636.             set text "$tmp$text"
  637.         }
  638.         replaceText $start $end $text
  639.         if {$isDoc} {
  640.             goto [expr $upos - $subs1]
  641.         } else {
  642.             set end [getPos]
  643.             select $start $end
  644.         }
  645.     }
  646.     message "$lett characters translated in $messageString."
  647. }
  648.  
  649.  
  650. #===============================================================================
  651. # General Commands
  652. #===============================================================================
  653.  
  654. # remove containing tags
  655. proc htmlUntagandSelect {} {htmlUntag 1}
  656.  
  657. proc htmlUntag {{selectit 0}} {
  658.     set curPos [getPos]
  659.     set tags [htmlGetContainer $curPos [selEnd]]
  660.     if {[llength $tags] < 5} {
  661.         alertnote "Cannot decide on enclosing tags."
  662.         return
  663.     }
  664.     # delete them
  665.     replaceText [lindex $tags 0] [lindex $tags 3] \
  666.     [getText [lindex $tags 1] [lindex $tags 2]]
  667.     if {$selectit} {
  668.         select [lindex $tags 0] \
  669.             [expr [lindex $tags 2] - [lindex $tags 1] + [lindex $tags 0]]
  670.     } else {
  671.         if {$curPos < [lindex $tags 1]} {set curPos [lindex $tags 1]}
  672.         if {$curPos > [lindex $tags 2]} {set curPos [lindex $tags 2]}
  673.         goto [expr $curPos - [lindex $tags 1] + [lindex $tags 0]]
  674.     }
  675.     message "[lindex $tags 4] deleted."
  676. }
  677.  
  678. # select container, like Balance (cmd-B)
  679. proc htmlSelectinContainer {} {htmlSelectContainer 1}
  680.  
  681. proc htmlSelectContainer {{inside 0}} {
  682.     set start [getPos]
  683.     if {$start != 0 &&
  684.             ![catch {getText $start [expr $start + 2]} lookingAt] &&
  685.             $lookingAt != "</" &&
  686.             [string range $lookingAt 0 0] == "<"} {
  687.         incr start -1
  688.     }
  689.     set tags [htmlGetContainer $start [selEnd]]
  690.     if {[llength $tags] == 5} {
  691.         if {$inside} {
  692.             select [lindex $tags 1] [lindex $tags 2]
  693.         } else {
  694.             select [lindex $tags 0] [lindex $tags 3]
  695.         }
  696.         message "[lindex $tags 4] selected."
  697.     } else {
  698.         beep
  699.         message "Cannot decide on enclosing tags."
  700.     }
  701. }
  702.  
  703. # Select an opening tag, or remove it, of an element without a closing tag.
  704. proc htmlRemoveOpening {} {htmlSelectOpening 1}
  705.  
  706. proc htmlSelectOpening {{remove 0}} {
  707.     set begin [getPos]
  708.     # back up one if possible and selection is wanted.
  709.     if {$begin >0 && !$remove} {incr begin -1}
  710.     set tag [htmlGetOpening $begin]
  711.     if {[llength $tag] == 3} {
  712.         if {$remove} {
  713.             deleteText [lindex $tag 0] [lindex $tag 1]
  714.             if {$begin < [lindex $tag 1]} {set begin [lindex $tag 1]}
  715.             goto [expr $begin - [lindex $tag 1] + [lindex $tag 0]]
  716.             message "[lindex $tag 2] deleted."
  717.         } else {
  718.             select [lindex $tag 0] [lindex $tag 1]
  719.             message "[lindex $tag 2] selected."
  720.         }
  721.     } else {
  722.         if {$remove} {
  723.             alertnote "Cannot find opening tag."
  724.         } else {
  725.             beep
  726.             message "Cannot find opening tag."
  727.         }
  728.     }
  729. }
  730.  
  731. # Called by cmd-double-click.
  732. # Change attributes if click on a tag.
  733. proc htmlChangeDblClick {} {
  734.     set pos [getPos]
  735.     if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $pos} res] ||
  736.     [lindex $res 1] < $pos} {return}
  737.     set txt [getText [expr [lindex $res 0] + 1] [expr [lindex $res 1] - 1]]
  738.     if {[string index [set tag [lindex $txt 0]] 0] == "/" || $tag == "!--"} {return}
  739.     if {[set newTag [htmlChangeElement $txt [string toupper $tag] [lindex $res 0]]] != ""} {
  740.         replaceText [lindex $res 0] [lindex $res 1] $newTag
  741.     }
  742. }
  743.  
  744. # Change an existing element.
  745. proc htmlChangeContainer {} {
  746.     set tag [htmlGetContainer [getPos] [selEnd]]
  747.     if {[llength $tag] == 5} {
  748.         set newTag [htmlChangeElement [getText [expr [lindex $tag 0] + 1] \
  749.         [expr [lindex $tag 1] - 1]] [lindex $tag 4] [lindex $tag 0]]
  750.         if {[string length $newTag]} {
  751.             replaceText [lindex $tag 0] [lindex $tag 1] $newTag
  752.         }
  753.     } else {
  754.         alertnote "Cannot decide on enclosing tags."
  755.     }
  756. }
  757.  
  758. proc htmlChangeOpening {} {
  759.     set tag [htmlGetOpening [getPos]]
  760.     if {[llength $tag] == 3} {
  761.         set newTag [htmlChangeElement [getText [expr [lindex $tag 0] + 1] \
  762.         [expr [lindex $tag 1] - 1]] [lindex $tag 2] [lindex $tag 0]]
  763.         if {[string length $newTag]} {
  764.             replaceText [lindex $tag 0] [lindex $tag 1] $newTag
  765.         }
  766.     } else {
  767.         alertnote "Cannot find opening tag."
  768.     }
  769. }
  770.  
  771. #
  772. # Exstracts all attributes to a element from a list, and puts up a dialog window
  773. # where the user can change the attributes.
  774. #
  775. proc htmlChangeElement {tag elem {wrPos 0}} {
  776.     global htmlColorAttr htmlURLAttr HTMLmodeVars
  777.     global htmluserColorname htmlColorNumber
  778.     global htmlElemAttrOptional1 htmlElemKeyBinding
  779.     global htmlElemEventHandler1 htmlWindowAttr htmlPlugins
  780.     global htmlSpecURL htmlSpecColor htmlSpecWindow
  781.  
  782.     # Remove tabs and returns from list.
  783.     regsub -all "\[\t\r\]+" $tag " " tag
  784.     
  785.     # Remove element name.
  786.     set tagelem [lindex $tag 0]
  787.     set tag [string range $tag [string length $tagelem] end]
  788.     set attrs ""
  789.     set attrVals ""
  790.     
  791.     # Exstract the attributes.
  792.     while {[regexp {[ ]+([^ "]+"[^"]*"|[^ "]+)} $tag thisatt]} {
  793.         set tag [string range $tag [string length $thisatt] end]
  794.         set thisatt [htmlRemoveQuotes $thisatt]
  795.         lappend attrs [string toupper [string trim [lindex $thisatt 0]]]
  796.         lappend attrVals [lindex $thisatt 1]
  797.     }    
  798.     
  799.     # All INPUT elements are defined differently. Must extract TYPE.
  800.     if {$elem == "INPUT"} {
  801.         set typeIndex [lsearch -exact [string toupper $attrs] "TYPE="]
  802.         if {$typeIndex >= 0 } {
  803.             set elem [string toupper [lindex $attrVals $typeIndex]]
  804.             set used "INPUT TYPE=\"${elem}\""
  805.             if {![info exists htmlElemKeyBinding($elem)]} {set elem "INPUT TYPE=$elem"}
  806.             # Remove TYPE attribute from list.
  807.             set attrs [lreplace $attrs $typeIndex $typeIndex]
  808.             set attrVals [lreplace $attrVals $typeIndex $typeIndex]
  809.         } else {
  810.             beep 
  811.             message "INPUT element without a TYPE attribute."
  812.             return
  813.         } 
  814.     } else {
  815.         set used $elem
  816.     }
  817.     
  818.     # If EMBED element, choose which
  819.     if {$elem == "EMBED"} {
  820.         if {[catch {listpick -p "Which plug-in?" [lsort $htmlPlugins]} elem] || ![string length $elem]} {return}
  821.     }
  822.     
  823.     # If LI element, check in which list.
  824.     if {$elem == "LI"} {
  825.         set ltype [htmlFindList]
  826.         if {$ltype == "UL"} {
  827.             set elem "LI IN UL"
  828.         } elseif {$ltype == "OL"} {
  829.             set elem "LI IN OL"
  830.         }            
  831.     }
  832.             
  833.     # Element known by HTML mode?
  834.     if {![info exists htmlElemAttrOptional1($elem)]} {
  835.         alertnote "Unknown element: $elem"
  836.         return
  837.     }
  838.     
  839.     set useBig $HTMLmodeVars(changeInBigWindows)
  840.     set optatts [htmlGetOptional $elem]
  841.     set optattsUp [string toupper $optatts]
  842.     set alloptatts [htmlGetOptional $elem 1]
  843.     set alloptattsUp [string toupper $alloptatts]
  844.     set reqatts [htmlGetRequired $elem]
  845.     set allAttrs [htmlGetUsed $elem $reqatts $optatts]
  846.     set reallyAllAtts [string toupper [concat $reqatts $alloptatts]]
  847.     
  848.     set choices [htmlGetChoices $elem]
  849.     set numAttrs [htmlGetNumber $elem]
  850.     
  851.     set errText ""
  852.     
  853.     # First check if one which is normally not used is used.
  854.     set addNotUsed 0
  855.     set toup [string toupper $allAttrs]
  856.     foreach a $attrs {
  857.         if {[lsearch -exact $toup $a] < 0 && [lsearch -exact $reallyAllAtts $a] >= 0} {
  858.             regsub -all "\[ \n\r\t]+([join $allAttrs |])" " $optatts" " " notUsedAtts
  859.             append allAttrs " $notUsedAtts"
  860.             set addNotUsed 1
  861.             break
  862.         }
  863.     }
  864.     
  865.     # then check some hidden one is used
  866.     set addHidden 0
  867.     set toup [string toupper $allAttrs]
  868.     foreach a $attrs {
  869.         if {[lsearch -exact $toup $a] < 0 && [lsearch -exact $reallyAllAtts $a] >= 0} {
  870.             regsub -all "\[ \n\r\t]+([join $optatts |])" " $alloptatts" " " hiddenAtts
  871.             append allAttrs " $hiddenAtts"
  872.             set addNotUsed 1
  873.             set addHidden 1
  874.             break
  875.         }
  876.     }
  877.     # finally check if some is unknown
  878.     set toup [string toupper $allAttrs]
  879.     foreach a $attrs {
  880.         if {[lsearch -exact $toup $a] < 0} {
  881.             lappend errText "Unknown attribute: $a"
  882.         }
  883.     }
  884.     
  885.     # Add something if all attrs are hidden.
  886.     if {![llength $allAttrs]} {
  887.         set allAttrs $optatts
  888.         set addNotUsed 1
  889.     } 
  890.     
  891.     # Does this element have any attributes?
  892.     if {![llength $allAttrs]} {
  893.         if {[llength $errText]} {
  894.             if {[askyesno "$elem has no attributes. Remove the ones in the text?"] == "no"} {
  895.                 return
  896.             } else {
  897.                 return [htmlSetCase <$elem>]
  898.             }
  899.         } else {
  900.             beep
  901.             message "$elem has no attributes."
  902.             return
  903.         }
  904.     }
  905.     
  906.     set values ""
  907.     # Add two dummy elements for OK and Cancel buttons.
  908.     if {$useBig} {set values {0 0}}
  909.     set allAttrs [string toupper $allAttrs]
  910.     # Build a list with attribute vales.
  911.     foreach a $allAttrs {
  912.         set attrIndex [lsearch -exact $attrs $a]
  913.         if {$attrIndex >= 0 } {set aval [lindex $attrVals $attrIndex]}
  914.         set a2 [string trimright $a =]
  915.         if {[string index $a [expr [string length $a] - 1]] != "="} {
  916.             # Flag
  917.             if {$attrIndex >= 0} {
  918.                 lappend values 1
  919.             } else {
  920.                 lappend values 0
  921.             } 
  922.         } elseif {([lsearch -exact $htmlURLAttr $a] >= 0 && [lsearch -exact $htmlSpecURL "${elem}!=$a2"] < 0) || \
  923.             [lsearch -exact $htmlSpecURL "${elem}=$a2"] >= 0} {
  924.                 # URL
  925.             if {$attrIndex >= 0} {
  926.                 set aval [htmlURLunEscape $aval]
  927.                 htmlAddToCache URLs $aval
  928.                 if {$useBig} {
  929.                     lappend values "" $aval 0
  930.                 } else {
  931.                     lappend values $aval
  932.                 }
  933.             } else {
  934.                 if {$useBig} {
  935.                     lappend values "" "No value" 0
  936.                 } else {
  937.                     lappend values ""
  938.                 }
  939.             }
  940.         } elseif {([lsearch -exact $htmlColorAttr $a] >= 0 && [lsearch -exact $htmlSpecColor "${elem}!=$a2"] < 0) || \
  941.         [lsearch -exact $htmlSpecColor "${elem}=$a2"] >= 0} {
  942.             # Color
  943.             if {$attrIndex >= 0} {
  944.                 set aval [htmlCheckColorNumber $aval]
  945.                 if {$aval == 0} {
  946.                     lappend errText "$a: Invalid color number."
  947.                     if {$useBig} {
  948.                         lappend values "" "No value" 0
  949.                     } else {
  950.                         lappend values ""
  951.                     }
  952.                 } elseif {[info exists htmluserColorname($aval)]} {
  953.                     if {$useBig} {
  954.                         lappend values "" $htmluserColorname($aval) 0
  955.                     } else {
  956.                         lappend values $htmluserColorname($aval)
  957.                     }
  958.                 } elseif {[info exists htmlColorNumber($aval)]} {
  959.                     if {$useBig} {
  960.                         lappend values "" $htmlColorNumber($aval) 0
  961.                     } else {
  962.                         lappend values $htmlColorNumber($aval)
  963.                     }
  964.                 } else {
  965.                     if {$useBig} {
  966.                         lappend values $aval "No value" 0
  967.                     } else {
  968.                         lappend values $aval
  969.                     }
  970.                 }
  971.             } else {
  972.                 if {$useBig} {
  973.                     lappend values "" "No value" 0
  974.                 } else {
  975.                     lappend values ""
  976.                 }
  977.             }
  978.         } elseif {([lsearch -exact $htmlWindowAttr $a] >= 0 && [lsearch -exact $htmlSpecWindow "${elem}!=$a2"] < 0) || \
  979.         [lsearch -exact $htmlSpecWindow "${elem}=$a2"] >= 0} {
  980.             # Window
  981.             if {$attrIndex >= 0} {
  982.                 htmlAddToCache windows $aval
  983.                 if {$useBig} {
  984.                     lappend values "" $aval
  985.                 } else {
  986.                     lappend values $aval
  987.                 }
  988.             } else {
  989.                 if {$useBig} {
  990.                     lappend values "" "No value"
  991.                 } else {
  992.                     lappend values ""
  993.                 }
  994.             }
  995.         } elseif {[lsearch $numAttrs "${a}*"] >= 0} {
  996.             # Number
  997.             if {$attrIndex >= 0} {
  998.                 set numcheck [htmlCheckAttrNumber $elem $a $aval]
  999.                 if {$numcheck == 1} {
  1000.                     lappend values $aval
  1001.                 } else {
  1002.                     lappend errText "$a: $numcheck"
  1003.                     lappend values ""
  1004.                 }
  1005.             } else {
  1006.                 lappend values ""
  1007.             }
  1008.         } elseif {[lsearch $choices "${a}*"] >= 0} {
  1009.             # Choices
  1010.             if {$attrIndex >= 0} {
  1011.                 set match ""
  1012.                 if {!(($elem == "OL" || $elem == "LI IN OL") && $a == "TYPE=")} {
  1013.                     set aval [string toupper $aval]
  1014.                 }
  1015.                 foreach w $choices {
  1016.                     if {$w == "${a}${aval}"} {
  1017.                         set match $aval
  1018.                     }
  1019.                 }
  1020.                 if {[string length $match]} {
  1021.                     lappend values $match
  1022.                 } else {
  1023.                     lappend errText "$a: Unknown choice, $aval."
  1024.                     lappend values ""
  1025.                 }
  1026.             } else {
  1027.                 lappend values ""
  1028.             }    
  1029.         } elseif {$attrIndex >= 0} {
  1030.             # Any other
  1031.             lappend values $aval
  1032.         } else {
  1033.             lappend values ""
  1034.         }
  1035.     }
  1036.     # If invalid attributes, continue?
  1037.     if {[llength $errText] && ![htmlErrorWindow "$elem not well-defined" $errText 1]} {
  1038.         return 
  1039.     }
  1040.     if {$useBig} {
  1041.         set r [htmlOpenElemWindow $used $elem [posX $wrPos] $values $addNotUsed $addHidden $wrPos]
  1042.     } else {
  1043.         set r [htmlOpenElemStatusBar $used $elem [posX $wrPos] $values $addNotUsed $addHidden $wrPos]
  1044.     }
  1045.     return $r
  1046. }
  1047.  
  1048. # Removes all tags in a selection or the whole document.
  1049. proc htmlRemoveTags {} {
  1050.     if {![isSelection]} {
  1051.         if {[set ync [askyesno -c "Put text without tags in a new window?"]] == "cancel"} {return}
  1052.         set txt [htmlTagStrip [getText 0 [maxPos]]]
  1053.         if {$ync == "yes"} {
  1054.             new
  1055.             insertText $txt
  1056.         } else {
  1057.             replaceText 0 [maxPos] $txt
  1058.         }
  1059.     } else {
  1060.         replaceText [getPos] [selEnd] [htmlTagStrip [getSelect]]
  1061.     }
  1062. }
  1063.  
  1064. # Put quotes around all attributes
  1065. proc htmlQuoteAllAttributes {} {
  1066.     htmlScanAllTags quote
  1067. }
  1068.  
  1069. proc htmlTagstoLowercase {} {
  1070.     htmlScanAllTags case tolower
  1071. }
  1072.  
  1073. proc htmlTagstoUppercase {} {
  1074.     htmlScanAllTags case toupper
  1075. }
  1076.  
  1077. proc htmlScanAllTags {doWhat {upperLower ""}} {
  1078.     set pos [getPos]
  1079.     if {[isSelection]} {
  1080.         set start [getPos]
  1081.         set end [selEnd]
  1082.     } else {
  1083.         set start 0
  1084.         set end [maxPos]
  1085.     }
  1086.     set text [getText $start $end]
  1087.     while {[regexp -indices {<!--|<[^<>]+>} $text tag]} {
  1088.         append newtext [string range $text 0 [lindex $tag 0]]
  1089.         set this [string range $text [expr [lindex $tag 0] + 1] [lindex $tag 1]]
  1090.         set text [string range $text [expr [lindex $tag 1] + 1] end]
  1091.         if {$this == "!--"} {
  1092.             if {[regexp -indices -- {-->} $text commend]} {
  1093.                 append newtext $this[string range $text 0 [lindex $commend 1]]
  1094.                 set text [string range $text [expr [lindex $commend 1] + 1] end]
  1095.             } else {
  1096.                 append newtext $text
  1097.                 set text ""
  1098.             }
  1099.         } else {
  1100.             if {$doWhat == "quote"} {
  1101.                 regsub -all "(\[ \t\r\]+\[^=\]+=)(\[^ >\"\t\r\]+)" $this {\1"\2"} newtag
  1102.             } else {
  1103.                 regsub -all "^\[^ \t\r>]+|\[ \t\r\]+\[^ \t\r=\]+=" $this "\[string $upperLower \"&\"\]" newtag
  1104.                 set newtag [subst $newtag]
  1105.             }
  1106.             append newtext $newtag
  1107.         }
  1108.     }
  1109.     append newtext $text
  1110.     replaceText $start $end $newtext
  1111.     goto $pos
  1112.     
  1113. }
  1114.  
  1115. # opens the manual in the browser.
  1116. proc htmlHelp {} {
  1117.     global HOME HTMLmodeVars modifiedModeVars browserSig
  1118.     switch $HTMLmodeVars(manualStartPage) {
  1119.         0 {set start HTMLmanual.html}
  1120.         1 {set start text:TableOfContents.html}
  1121.         2 {set start text:HTMLmanualFrames.html}
  1122.     }
  1123.     set path "$HTMLmodeVars(manualFolder):$start"
  1124.     if {![file exists $path]} {
  1125.         if {![catch {htmlGetDir "Locate manual"} folder]} {
  1126.             set path "$folder:$start"
  1127.             if {![file exists $path]} {
  1128.                 alertnote "Folder doesn't contain the HTML manual."
  1129.                 return
  1130.             }
  1131.             set HTMLmodeVars(manualFolder) $folder
  1132.             lappend modifiedModeVars {manualFolder HTMLmodeVars}
  1133.         } else {
  1134.             return
  1135.         }
  1136.     }
  1137.     htmlSendWindow $path
  1138.      if {!$HTMLmodeVars(browseInForeground)} { switchTo '$browserSig' }
  1139. }
  1140.  
  1141. #
  1142. # launch a viewer and pass this window to it
  1143. #
  1144. proc htmlSendWindow {{path ""}} {
  1145.     global HTMLmodeVars browserSig htmlPreviCabWin
  1146.  
  1147.     if {$path == ""} {
  1148.         set path [stripNameCount [lindex [winNames -f] 0]]
  1149.  
  1150.         if {[winDirty]} {
  1151.             if {$HTMLmodeVars(saveWithoutAsking) || [set ask [askyesno -c "Save '[file tail $path]'?"]] == "yes"} {
  1152.                 save
  1153.             } elseif {$ask == "cancel"} {
  1154.                 return
  1155.             } elseif {![file exists $path]} {
  1156.                 alertnote "Can't send window to browser."
  1157.                 return
  1158.             }
  1159.         }
  1160.         # Get path again, in case it was Untitled before.
  1161.         set path [stripNameCount [lindex [winNames -f] 0]]
  1162.     }
  1163.     if {![info exists browserSig] && [catch {getFileSig [icGetPref -t 1 Helper•http]} browserSig]} {set browserSig MOSS}
  1164.     if {![app::isRunning $browserSig] && [catch {app::launchBack $browserSig}]} {
  1165.         getApplSig "Please locate your web browser" browserSig
  1166.         app::launchBack $browserSig
  1167.     }
  1168.     
  1169.     # MSIE opens the file in a new window unless an open URL event is used.
  1170.     # Cyberdog opens the text file unless an open URL event is used.
  1171.     if {$browserSig == "MSIE" || $browserSig == "dogz" || $browserSig == "iCAB"} {
  1172.         set path [htmlURLescape $path 1]
  1173.         regsub -all : $path / path
  1174.         set flgs ""
  1175.         if {$browserSig == "MSIE"} {set flgs "FLGS 1"}
  1176.         if {$browserSig == "iCAB"} {set flgs "WIND -1"}
  1177.         if {$browserSig == "iCAB" && [info exists htmlPreviCabWin] && $path == $htmlPreviCabWin} {
  1178.             AEBuild '$browserSig' core clos "----" "obj{form:indx, want:type(cwin), seld:1, from:'null'()}"
  1179.         }
  1180.         if {$browserSig == "iCAB"} {set htmlPreviCabWin $path}
  1181.         eval AEBuild '$browserSig' WWW! OURL "----" "“file:///$path”" $flgs
  1182.     } else {
  1183.         sendOpenEvent noReply '$browserSig' $path
  1184.     }
  1185.      if {$HTMLmodeVars(browseInForeground)} { switchTo '$browserSig' }
  1186. }
  1187.  
  1188. #===============================================================================
  1189. # Caches
  1190. #===============================================================================
  1191.  
  1192.  
  1193. proc htmlCleanUpCache {cache} {
  1194.     global HTMLmodeVars 
  1195.     global modifiedModeVars
  1196.     
  1197.     set URLs $HTMLmodeVars($cache)
  1198.  
  1199.     if {![llength $URLs]} {
  1200.         alertnote "No $cache are cached."
  1201.         return
  1202.     }
  1203.     set urlnumber [llength $URLs]
  1204.     set screenHeight [lindex [getMainDevice] 3]
  1205.     set maxLines [expr ($screenHeight - 160) / 20]
  1206.     set pages [expr ($urlnumber - 1) / $maxLines ]
  1207.     set thispage 0
  1208.     for {set i 0} {$i < $urlnumber} {incr i} {
  1209.         lappend URLsToSave 1
  1210.     }
  1211.     set thisbox $URLsToSave
  1212.     while {1} {
  1213.         if {$thispage < $pages} {
  1214.             set thisurlnumber $maxLines
  1215.         } else {
  1216.             set thisurlnumber [expr ($urlnumber - 1 ) % $maxLines + 1]
  1217.         }
  1218.         set height [expr 75 + $thisurlnumber  * 20]
  1219.         set box "-w 440 -h $height -b OK 20 [expr $height - 30]  85 [expr $height - 10] \
  1220.             -b Cancel 100 [expr $height - 30] 165 [expr $height - 10] \
  1221.             -b {Uncheck all} 180 [expr $height - 30] 265 [expr $height - 10] \
  1222.             -t {Uncheck the $cache you want to remove} 10 10 440 30 "
  1223.         if {$thispage < $pages} {
  1224.             lappend box -b "More…" 280 [expr $height - 30] 345 [expr $height - 10]
  1225.         }
  1226.         if {$thispage > 0} {
  1227.             lappend box -b "Back…" 360 [expr $height - 30] 425 [expr $height - 10]
  1228.         }
  1229.  
  1230.         set hpos 30 
  1231.         set thisURLs [lrange $URLs [expr $thispage * $maxLines] \
  1232.         [expr $thispage * $maxLines + $maxLines - 1]]
  1233.         set i 0
  1234.         foreach url $thisURLs {
  1235.             lappend box -c $url [lindex $thisbox $i] 10 $hpos 430 [expr $hpos + 15]
  1236.             incr i
  1237.             incr hpos 20
  1238.         }
  1239.         set thisbox [eval [concat dialog $box]]
  1240.         if {[lindex $thisbox 1]} {
  1241.             # cancel
  1242.             return
  1243.         } elseif {[lindex $thisbox 2]} {
  1244.             # uncheck all
  1245.             set thisbox {}
  1246.             for {set i 0} {$i < [llength $thisbox]} {incr i} {
  1247.                 lappend thisbox 0
  1248.             }
  1249.         } else {
  1250.             if {$pages == 0} {
  1251.                 set ll 3
  1252.             } elseif {$thispage == 0 || $thispage == $pages} {
  1253.                 set ll 4
  1254.             } else {
  1255.                 set ll 5
  1256.             }
  1257.             set URLsToSave [eval [concat lreplace [list $URLsToSave] [expr $thispage * $maxLines] \
  1258.             [expr $thispage * $maxLines + $maxLines - 1] [lrange $thisbox $ll end]]]
  1259.             if {[lindex $thisbox 0]} { 
  1260.                 # OK
  1261.                 break
  1262.             } elseif {$thispage < $pages && [lindex $thisbox 3]} { 
  1263.                 # more
  1264.                 incr thispage 1
  1265.                 set thisbox [lrange $URLsToSave [expr $thispage * $maxLines] \
  1266.                 [expr $thispage * $maxLines + $maxLines - 1]]
  1267.             } else {
  1268.                 # back
  1269.                 incr thispage -1
  1270.                 set thisbox [lrange $URLsToSave [expr $thispage * $maxLines] \
  1271.                 [expr $thispage * $maxLines + $maxLines - 1]]
  1272.             }
  1273.         }
  1274.     }
  1275.     set newurls {}
  1276.     for {set i 0} {$i < $urlnumber} {incr i} {
  1277.         if {[lindex $URLsToSave $i]} {
  1278.             lappend newurls [lindex $URLs $i]
  1279.         }
  1280.     }
  1281.     set HTMLmodeVars($cache) $newurls
  1282.     lappend modifiedModeVars [list $cache HTMLmodeVars]
  1283.     if {![llength $newurls]} {htmlEnable$cache off}
  1284. }
  1285.  
  1286. proc htmlSelScrapToURL {sel msg1 msg2} {
  1287.     set newurl [htmlURLunEscape [string trim [eval get$sel]]]
  1288.     # Convert tabs and returns.
  1289.     if {[regexp {[\t\r\n]} $newurl]} {
  1290.         alertnote "$msg1 contains tabs or returns. It will not be added to the URL cache."
  1291.         return
  1292.     }
  1293.     if {[string length $newurl]} {
  1294.         htmlAddToCache URLs $newurl
  1295.         message "$newurl added to URLs."
  1296.     } else {
  1297.         beep
  1298.         message $msg2
  1299.     }
  1300. }
  1301.  
  1302. proc htmlAddSelection {} {
  1303.     htmlSelScrapToURL Select Selection "No selection!"
  1304. }
  1305.  
  1306. proc htmlAddClipboard {} {
  1307.     htmlSelScrapToURL Scrap Clipboard "Clipboard empty!"
  1308. }
  1309.  
  1310. proc htmlClearCache {cache} {
  1311.     global HTMLmodeVars modifiedModeVars
  1312.     if {[askyesno "Remove all $cache from [string range $cache 0 [expr [string length $cache] - 2]] cache?"] == "yes"} {
  1313.         set HTMLmodeVars($cache) {}
  1314.         lappend modifiedModeVars [list $cache HTMLmodeVars]
  1315.         htmlEnable$cache off
  1316.     }
  1317. }
  1318.  
  1319. # Imports all URLs in a file to the cache.
  1320. proc htmlImport {} {
  1321.     global HTMLmodeVars modifiedModeVars htmlURLAttr
  1322.     set urls $HTMLmodeVars(URLs)
  1323.  
  1324.     if {[catch {getfile "Import URLs from:"} fil] || ![htmlIsTextFile $fil alertnote]} {return}
  1325.     set fid [open $fil r]
  1326.     set filecont " [read $fid]"
  1327.     close $fid
  1328.     if {[llength $urls]} {
  1329.         set cl [askyesno -c "Clear URL cache before importing?"]
  1330.         if {$cl == "cancel"} {
  1331.             return
  1332.         } elseif {$cl == "yes"} {
  1333.             set urls {}
  1334.         }
  1335.     }
  1336.             
  1337.     set exp1 "\[ \\t\\n\\r\]+("
  1338.     foreach attr $htmlURLAttr {
  1339.         append exp1 "$attr|"
  1340.     }
  1341.     set exp1 [string trimright $exp1 |]
  1342.     append exp1 ")(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  1343.     set exp2 {[ \t\r\n]+(url)\(\"?([^\"\)]+)\"?\)}
  1344.     for {set i1 1} {$i1 < 3} {incr i1} {
  1345.         set fcont $filecont
  1346.         set exp [set exp$i1]
  1347.         while {[regexp -nocase -indices $exp $fcont a b url]} {
  1348.             set link [htmlURLunEscape [string trim [string range $fcont [lindex $url 0] [lindex $url 1]] \"]]
  1349.             set fcont [string range $fcont [lindex $url 1] end]
  1350.             if {[lsearch -exact $urls $link] < 0} {
  1351.                 lappend urls  $link
  1352.             }
  1353.         }
  1354.     }
  1355.     set HTMLmodeVars(URLs) [lsort $urls]
  1356.     lappend modifiedModeVars {URLs HTMLmodeVars}
  1357.     htmlEnableURLs [expr ([llength $HTMLmodeVars(URLs)] > 0)]
  1358.     message "URLs imported."
  1359. }
  1360.  
  1361. # Export URLs in cache to a file.
  1362. proc htmlExport {} {
  1363.     global HTMLmodeVars
  1364.     if {![llength $HTMLmodeVars(URLs)]} {
  1365.         alertnote "URL cache is empty."
  1366.         return
  1367.     }
  1368.     foreach url $HTMLmodeVars(URLs) {
  1369.         lappend out "HREF=\"$url\""
  1370.     }
  1371.     if {![catch {putfile "Export URL cache to:" "URL cache"} fil]} {
  1372.         if {[file exists $fil]} {removeFile $fil}
  1373.         set fid [open $fil w]
  1374.         puts $fid [join $out "\n"]
  1375.         close $fid
  1376.         message "URLs exported."
  1377.     }
  1378. }
  1379.  
  1380. # Add all files in a folder to URL cache.
  1381. proc htmlAddFolder {} {
  1382.     global HTMLmodeVars modifiedModeVars
  1383.     if {[catch {htmlGetDir "Folder to cache:"} folder]} {return}
  1384.     set path ""
  1385.     foreach hp $HTMLmodeVars(homePages) {
  1386.         if {[string match "[lindex $hp 0]:*" "$folder:"]} {
  1387.             set path [string range $folder [expr [string length [lindex $hp 0]] +1] end]
  1388.             regsub -all {:} $path {/} path
  1389.             if {[string length $path]} {append path /}
  1390.         }
  1391.     }
  1392.     set val [dialog -w 350 -h 80 -t "Path:" 10 10 60 30 -e $path 70 10 340 25 \
  1393.     -b OK 20 50 85 70 -b Cancel 110 50 175 70]
  1394.     if {[lindex $val 2]} {return}
  1395.     set path [string trim [lindex $val 0]]
  1396.     if {[string length $path]} {set path "[string trimright $path /]/"}
  1397.     set urls $HTMLmodeVars(URLs)
  1398.     if {[llength $urls]} {
  1399.         set cl [askyesno -c "Clear URL cache first?"]
  1400.         if {$cl == "cancel"} {
  1401.             return
  1402.         } elseif {$cl == "yes"} {
  1403.             set urls {}
  1404.         }
  1405.     }
  1406.  
  1407.     foreach fil [glob -nocomplain "$folder:*"] {
  1408.         set name [file tail $fil]
  1409.         if {![file isdirectory $fil] && [lsearch -exact $urls "$path$name"] < 0} {
  1410.             lappend urls "$path$name"
  1411.         }
  1412.     }
  1413.     set HTMLmodeVars(URLs) [lsort $urls]
  1414.     lappend modifiedModeVars {URLs HTMLmodeVars}
  1415.     htmlEnableURLs [expr ([llength $HTMLmodeVars(URLs)] > 0)]
  1416.     message "Files added to URL cache."
  1417. }
  1418.  
  1419.  
  1420. #===============================================================================
  1421. #  Footers
  1422. #===============================================================================
  1423.  
  1424. proc htmlFooters {} {
  1425.     global HTMLmodeVars modifiedModeVars
  1426.     
  1427.     set footers [lsort $HTMLmodeVars(footers)]
  1428.     set touchedIt 0
  1429.     set this ∞
  1430.     while {1} {
  1431.         set box "-t {Footers:} 10 10 80 30 \
  1432.         -t Path: 30 50 80 70 \
  1433.         -b OK 10 110 75 130 -b Cancel 90 110 155 130 -b New… 170 110 235 130"
  1434.         if {[llength $footers]} {
  1435.             set foot ""
  1436.             foreach f $footers {
  1437.                 lappend foot [file tail $f]
  1438.             }
  1439.             append box " -m [list [concat [list $this] $foot]] 90 10 440 30"
  1440.             append box " -b Remove 250 110 315 130 -b Insert 330 110 395 130"
  1441.             foreach f $footers {
  1442.                 lappend box -n [file tail $f] -t $f 90 50 440 90
  1443.             }
  1444.         } else {
  1445.             append box  " -m {{None defined} {None defined}} 90 10 440 30"
  1446.         }
  1447.         set values [eval [concat dialog -w 450 -h 140 $box]]
  1448.         set this [lindex $values 3]
  1449.         if {[lindex $values 0]} {
  1450.             set HTMLmodeVars(footers) $footers
  1451.             lappend modifiedModeVars {footers HTMLmodeVars}
  1452.             return
  1453.         } elseif {[lindex $values 1]} {
  1454.             if {!$touchedIt || [askyesno "Really cancel without saving changes?"] == "yes"} {return}
  1455.         } elseif {[lindex $values 2]} {
  1456.             if {![catch {htmlNewFooter $footers} newfoot]} {
  1457.                 lappend footers $newfoot
  1458.                 set footers [lsort $footers]
  1459.                 set this [file tail $newfoot]
  1460.                 set touchedIt 1
  1461.             }
  1462.         } else {
  1463.             set i [lsearch -exact $foot $this]
  1464.             set footerFile [lindex $footers $i]
  1465.             if {[lindex $values 5]} {
  1466.                 if {![catch {readFile $footerFile} footText]} {
  1467.                     insertText "\r$footText\r"
  1468.                     set HTMLmodeVars(footers) $footers
  1469.                     lappend modifiedModeVars {footers HTMLmodeVars}
  1470.                     message "$this inserted."
  1471.                     return
  1472.                 } else {
  1473.                     alertnote "Could not read $this."
  1474.                 }
  1475.             } else {
  1476.                 set footers [lreplace $footers $i $i]
  1477.                 set touchedIt 1
  1478.             }
  1479.         }
  1480.     }    
  1481. }
  1482.  
  1483. # Define a file as a footer.
  1484. proc htmlNewFooter {footers} {
  1485.     set newFooter [getfile "Select the file with the footer."]
  1486.     if {![htmlIsTextFile $newFooter alertnote]} {
  1487.         error ""
  1488.     } elseif {[lsearch -exact $footers $newFooter] < 0} {
  1489.         # Can't define two footers with the same file name.
  1490.         foreach f $footers {
  1491.             if {[file tail $f] == [file tail $newFooter]} {
  1492.                 alertnote "There is already a footer with the filename\
  1493.                 '[file tail $newFooter]'. Two footers with the same filename\
  1494.                 cannot be defined."
  1495.                 error ""
  1496.             }
  1497.         }
  1498.         return $newFooter
  1499.     } else {
  1500.         alertnote "'[file tail $newFooter]' already a footer."
  1501.         error ""
  1502.     }
  1503. }
  1504.  
  1505.  
  1506. #===============================================================================
  1507. # Last modified
  1508. #===============================================================================
  1509.  
  1510. proc htmlLastModified {} {
  1511.     global HTMLmodeVars
  1512.     set values [dialog -w 300 -h 190 -t "Last modified tags" 40 10 200 30 \
  1513.     -e $HTMLmodeVars(lastModified) 10 40 290 55 -t "Date format" 10 70 100 90 \
  1514.     -r "Long" 1 10 95 70 115 -r "Abbreviated" 0 80 95 180 115 -r "Short" 0 190 95 250 115 \
  1515.     -c "Include weekday" 0 10 120 150 140 -c "Include time" 0 160 120 290 140 \
  1516.     -b OK 20 160 85 180 -b Cancel 110 160 175 180]
  1517.     if {[lindex $values 7]} {return}
  1518.     set lm [htmlQuote [lindex $values 0]]
  1519.     set indent [htmlFindNextIndent]
  1520.     set text "<!-- [htmlSetCase "#LASTMODIFIED TEXT"]=\"$lm\" [htmlSetCase FORM]=\""
  1521.     if {[lindex $values 1]} {append text [htmlSetCase LONG]}
  1522.     if {[lindex $values 2]} {append text [htmlSetCase ABBREV]}
  1523.     if {[lindex $values 3]} {append text [htmlSetCase SHORT]}
  1524.     if {[lindex $values 4]} {append text [htmlSetCase ",WEEKDAY"]}
  1525.     if {[lindex $values 5]} {append text [htmlSetCase ",TIME"]}
  1526.     append text "\" -->"
  1527.     set text "$text\r$indent[htmlGetLastMod $text]\r$indent<!-- [htmlSetCase /#LASTMODIFIED] -->"
  1528.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#LASTMODIFIED[ \t\r]+[^>]+>} 0} res] &&
  1529.     ![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#LASTMODIFIED[ \t\r]+[^>]+>} [lindex $res 1]} res2]} {
  1530.         if {[askyesno "There are already 'last modified' tags in this document. Replace them?"] == "yes"} {
  1531.             replaceText [lindex $res 0] [lindex $res2 1] $text
  1532.         }
  1533.     } else {
  1534.         insertText [htmlOpenCR $indent 1] $text "\r$indent\r$indent"
  1535.     }
  1536. }
  1537.  
  1538. proc htmlUpdateLastMod {args} {
  1539.     set name [lindex $args [expr [llength $args] - 1]]
  1540.     if {[lindex [winNames -f] 0] != $name} {bringToFront $name}
  1541.     set spos 0
  1542.     while {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#LASTMODIFIED[ \t\r]+[^>]+>} $spos} res]} {
  1543.         if {[catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#LASTMODIFIED[ \t\r]+[^>]+>} [lindex $res 1]} res2]} {
  1544.             alertnote "The window '[file tail $name]' contains an opening 'last modified' tag without a matching closing tag."
  1545.             return
  1546.         }
  1547.         set str [htmlGetLastMod [getText [lindex $res 0] [expr [lindex $res 1] + 1]]]
  1548.         if {$str == "0"} {
  1549.             alertnote "The window '[file tail $name]' contains invalid 'last modified' tags."
  1550.         } else {
  1551.             set indent [htmlFindIndent [lindex $res 0]]
  1552.             replaceText [lindex $res 1] [lindex $res2 0] "\r" $indent $str "\r" $indent
  1553.         }
  1554.         set spos [lindex $res2 1]
  1555.     }
  1556. }
  1557.  
  1558. proc htmlGetLastMod {str} {
  1559.     global htmlSpecialCharacter htmlSpecialCapCharacter
  1560.     set text ""
  1561.     set form ""
  1562.     set type ""
  1563.     if {![regexp -nocase {TEXT=\"([^\"]*)\"} $str dum text] ||
  1564.     ![regexp -nocase {FORM=\"([^\"]*)\"} $str dum form] || $form == "" ||
  1565.     ![regexp -nocase {[^,]*} $form type] || 
  1566.     [lsearch -exact [list LONG ABBREV SHORT] [string toupper $type]] < 0} {return 0}
  1567.     set text [htmlUnQuote $text]
  1568.     set day [string match "*WEEKDAY*" [string toupper $form]]
  1569.     set tid [string match "*TIME*" [string toupper $form]]
  1570.     set date [mtime [now] [string tolower $type]]
  1571.     if {!$day && [string toupper $type] != "SHORT"} {
  1572.         set date [lreplace $date 0 0 [lrange [lindex $date 0] 1 end]]
  1573.     }
  1574.     if {!$tid} {
  1575.         set date [lindex $date 0]
  1576.     } else {
  1577.         set tiden [lindex $date 1]
  1578.         regexp {^[0-9]+[^0-9]+[0-9]+} $tiden tidstr
  1579.         set tiden [lreplace $tiden 0 0 $tidstr]
  1580.         set date [lreplace $date 1 1 $tiden]
  1581.     }
  1582.     set text "$text [join $date]"
  1583.     regsub -all "&" $text "\\&" text
  1584.     regsub -all "<" $text "\\<" text
  1585.     regsub -all ">" $text "\\>" text
  1586.     regsub -all "¿" $text "\\¿" text
  1587.     regsub -all "¡" $text "\\¡" text
  1588.     foreach c [array names htmlSpecialCharacter] {
  1589.         regsub -all $c $text "\\&$htmlSpecialCharacter($c);" text
  1590.     }
  1591.     foreach c [array names htmlSpecialCapCharacter] {
  1592.         regsub -all $c $text "\\&$htmlSpecialCapCharacter($c);" text
  1593.     }
  1594.     foreach c [list eth ETH thorn THORN] {
  1595.         regsub -all "&$c;" $text $c text
  1596.     }
  1597.     return $text
  1598. }
  1599.  
  1600. #===============================================================================
  1601. # Home page windows
  1602. #===============================================================================
  1603.  
  1604. proc htmlOpenHPwin {{folder ""}} {
  1605.     global htmlHomePageWinList
  1606.     # Get folder to open.
  1607.     if {$folder == "" && [catch {htmlGetDir "Open:"} folder]} {return}
  1608.     set tail [file tail $folder]
  1609.     # Is their already a window for this folder?
  1610.     foreach win $htmlHomePageWinList {
  1611.         if {[lindex $win 0] == $folder} {
  1612.             bringToFront [lindex $win 1]
  1613.             return
  1614.         }    
  1615.     }
  1616.     if {[catch {glob $folder:*} fileList]} {beep; message "Empty folder."; return}
  1617.     
  1618.     set text "$folder\rcmd-shift-C to copy URL\r"
  1619.     foreach fil $fileList {
  1620.         append text [file tail $fil] \r
  1621.     }
  1622.     if {[set winsize [htmlGetHPwinSize $folder]] == ""} {
  1623.         new -n $tail -m Home
  1624.     } else {
  1625.         eval new -n [list "$tail"] -g $winsize -m Home
  1626.     }
  1627.     insertText $text
  1628.     if {$winsize == ""} {shrinkWindow 1}
  1629.     # make folders boldface
  1630.     for {set i 0} {$i < [llength $fileList]} {incr i} {
  1631.         set fil [lindex $fileList $i]
  1632.         if {[file isdirectory $fil]} {
  1633.             insertColorEscape [rowColToPos [expr $i + 3] 0] bold
  1634.             insertColorEscape [rowColToPos [expr $i + 4] 0] 12
  1635.         }
  1636.     }
  1637.     htmlSetWin
  1638.     lappend htmlHomePageWinList [list $folder [lindex [winNames] 0]]
  1639. }
  1640.  
  1641. # Reads a saved home page window size.
  1642. proc htmlGetHPwinSize {folder} {
  1643.     global PREFS htmlHPwinPositions
  1644.     if {[info exists htmlHPwinPositions($folder)]} {return $htmlHPwinPositions($folder)}
  1645.     if {![file exists "$PREFS:HTML:Home page window positions"]} {return}
  1646.     set cid [scancontext create]
  1647.     set pos ""
  1648.     scanmatch $cid "^\{?$folder\[ \}\]" {
  1649.         if {[lindex $matchInfo(line) 0] == $folder} {set pos [lrange $matchInfo(line) 1 end]}
  1650.     }
  1651.     set fid [open "$PREFS:HTML:Home page window positions"]
  1652.     scanfile $cid $fid
  1653.     close $fid
  1654.     scancontext delete $cid
  1655.     return $pos
  1656. }
  1657.  
  1658. proc htmlQuitHook {} {
  1659.     global PREFS htmlHPwinPositions
  1660.     if {![info exists htmlHPwinPositions]} {return}
  1661.     message "Saving home page window positions…"
  1662.     set current ""
  1663.     if {[file exists "$PREFS:HTML:Home page window positions"] && 
  1664.     ![catch {open "$PREFS:HTML:Home page window positions"} fid]} {
  1665.         set current [split [read -nonewline $fid] \n]
  1666.         close $fid
  1667.     }
  1668.     foreach c $current {
  1669.         if {[info exists htmlHPwinPositions([lindex $c 0])]} {
  1670.             append n [lrange $c 0 0] " " $htmlHPwinPositions([lindex $c 0]) \n
  1671.             unset htmlHPwinPositions([lindex $c 0])
  1672.         } else {
  1673.             append n $c \n
  1674.         }
  1675.     }
  1676.     foreach c [array names htmlHPwinPositions] {
  1677.         append n [list $c] " " $htmlHPwinPositions($c) \n
  1678.     }
  1679.     if {![catch {open "$PREFS:HTML:Home page window positions" w} fid]} {
  1680.         puts -nonewline $fid $n
  1681.         close $fid
  1682.     }
  1683. }
  1684.  
  1685.  
  1686. # Quick search in home page windows just like in Finder windows.
  1687. proc htmlSearchInHPwin {char} {
  1688.     global homeTime hpWinString
  1689.     set t [ticks]
  1690.     if {[expr $t - $homeTime] > 60} {set hpWinString ""}
  1691.     append hpWinString $char
  1692.     set homeTime $t
  1693.     if {[catch {search -s -f 1 -m 0 -r 1 -i 1 "^$hpWinString" [nextLineStart [nextLineStart 0]]} res]} {return}
  1694.     select [lindex $res 0] [nextLineStart [lindex $res 1]]
  1695. }
  1696.  
  1697. proc htmlHomeReturn {} {
  1698.     global htmlHomePageWinList HTMLmodeVars
  1699.     foreach win $htmlHomePageWinList {
  1700.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1701.             set f [htmlGetAhpLine]
  1702.             if {![file exists $f]} {alertnote "[file tail $f] not found."; return}
  1703.             if {[file isdirectory $f]} {
  1704.                 htmlOpenHPwin $f
  1705.             } else {
  1706.                 getFileInfo $f a
  1707.                 if {$a(type) == "TEXT"} {
  1708.                     edit -c $f
  1709.                 } elseif {$HTMLmodeVars(homeOpenNonTextFile)} {
  1710.                     if {$a(type) == "APPL"} {
  1711.                         launch -f $f
  1712.                     } elseif {$a(creator) == "MACS"} {
  1713.                         beep; message "Cannot open."
  1714.                     } else {
  1715.                         launchDoc $f
  1716.                     }
  1717.                 } else {
  1718.                     beep; message "Not a text file."
  1719.                 }
  1720.             }
  1721.             return
  1722.         }
  1723.     }    
  1724. }
  1725.  
  1726. proc htmlHpWinBack {} {
  1727.     global htmlHomePageWinList
  1728.     foreach win $htmlHomePageWinList {
  1729.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1730.             set folder [file dirname [getText 0 [expr [nextLineStart 0] - 1]]]
  1731.             if {$folder != ""} {htmlOpenHPwin $folder}
  1732.             return
  1733.         }
  1734.     }
  1735. }
  1736.  
  1737. proc htmlGetAhpLine {} {
  1738.     return "[getText 0 [expr [nextLineStart 0] - 1]]:[getText [lineStart [getPos]] [expr [nextLineStart [getPos]] - 1]]"
  1739. }
  1740.  
  1741. # Refreshes a Home page window.
  1742. proc htmlRefreshHpWin {{hpwin ""}} {
  1743.     global htmlHomePageWinList
  1744.     if {$hpwin == ""} {
  1745.         foreach win $htmlHomePageWinList {
  1746.             if {[lindex [winNames] 0] == [lindex $win 1]} {
  1747.                 set hpwin $win
  1748.             }
  1749.         }
  1750.     }
  1751.     set curSel [file tail [htmlGetAhpLine]]
  1752.     set folder [lindex $hpwin 0]
  1753.     setWinInfo read-only 0
  1754.     if {![file exists ${folder}:] || [catch {glob $folder:*} files]} {killWindow; return}
  1755.     set len [llength $files]
  1756.     set pos [nextLineStart [nextLineStart 0]]
  1757.     set ind 0
  1758.     while {$pos < [maxPos] && $ind < $len} {
  1759.         set f [file tail [lindex $files $ind]]
  1760.         set t [string trim [getText $pos [nextLineStart $pos]]]
  1761.         while {$pos < [maxPos] && $ind < $len && $t == $f} {
  1762.             incr ind
  1763.             set pos [nextLineStart $pos]
  1764.             set f [file tail [lindex $files $ind]]
  1765.             set t [string trim [getText $pos [nextLineStart $pos]]]
  1766.         }
  1767.         if {[string compare [string tolower $t] [string tolower $f]] == 1} {
  1768.             goto $pos
  1769.             insertText $f \r
  1770.             if {[file isdirectory [lindex $files $ind]]} {
  1771.                 insertColorEscape $pos bold
  1772.                 if {![file isdirectory [lindex $files [expr $ind + 1]]]} {
  1773.                     insertColorEscape [nextLineStart $pos] 12
  1774.                 }
  1775.             } elseif {[file isdirectory [lindex $files [expr $ind + 1]]]} {
  1776.                 insertColorEscape $pos 12
  1777.                 insertColorEscape [nextLineStart $pos] bold
  1778.             }            
  1779.             set pos [nextLineStart $pos]
  1780.             incr ind
  1781.         } else {
  1782.             deleteText $pos [nextLineStart $pos]
  1783.         }
  1784.         if {$pos < [maxPos]} {set t [string trim [getText $pos [nextLineStart $pos]]]}
  1785.         set f [file tail [lindex $files $ind]]
  1786.     }
  1787.     if {$pos < [maxPos]} {
  1788.         deleteText [expr $pos - 1] [maxPos]
  1789.     } else {
  1790.         goto [maxPos]
  1791.         foreach f [lrange $files $ind end] {
  1792.             insertText [file tail $f] \r
  1793.             if {[file isdirectory $f]} {
  1794.                 insertColorEscape $pos bold
  1795.                 insertColorEscape [nextLineStart $pos] 12
  1796.             }
  1797.             set pos [nextLineStart $pos]    
  1798.         }
  1799.     }
  1800.     refresh
  1801.     setWinInfo dirty 0
  1802.     setWinInfo read-only 1
  1803.     beginningOfBuffer
  1804.     if {![catch {search -s -f 1 -m 0 -r 1 -- "^$curSel" 0} res]} {
  1805.         select [lindex $res 0] [nextLineStart [lindex $res 1]]
  1806.     }
  1807. }
  1808.  
  1809. proc htmlRefreshWindows {} {
  1810.     global htmlHomePageWinList
  1811.     set frontWin [lindex [winNames -f] 0]
  1812.     foreach win $htmlHomePageWinList {
  1813.         bringToFront [lindex $win 1]
  1814.         htmlRefreshHpWin $win
  1815.     }
  1816.     bringToFront $frontWin
  1817. }
  1818.  
  1819. # Copies an URL from a home page window.
  1820. proc htmlCopyURL {} {
  1821.     global htmlHomePageWinList htmlHomePageWinURL
  1822.     foreach win $htmlHomePageWinList {
  1823.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1824.             set htmlHomePageWinURL [htmlGetAhpLine]
  1825.             message "$htmlHomePageWinURL copied."
  1826.         }
  1827.     }
  1828. }
  1829.  
  1830. # Pastes a previously copied URL from a home page window.
  1831. proc htmlPasteURL {} {
  1832.     global htmlHomePageWinURL htmlIsSel htmlCurSel HTMLmodeVars elecStopMarker
  1833.     if {![info exists htmlHomePageWinURL]} {message "No URL to paste."; return}
  1834.     if {[set link [htmlGetFile 0 $htmlHomePageWinURL 2]] == ""} {return}
  1835.     set url [htmlURLescape2 [lindex $link 0]]
  1836.     htmlGetSel
  1837.     set absPos [getPos]
  1838.     set htmlWrapPos [posX [getPos]]
  1839.     if {[llength [set wh [lindex $link 1]]]} {
  1840.         set text [htmlSetCase <IMG]
  1841.         append text [htmlWrapTag "[htmlSetCase SRC=]\"$url\""]
  1842.         append text [htmlWrapTag [htmlSetCase "WIDTH=\"[lindex $wh 0]\""]]
  1843.         append text [htmlWrapTag [htmlSetCase "HEIGHT=\"[lindex $wh 1]\">"]]
  1844.         set closing ""
  1845.     } else {
  1846.         set text "<[htmlSetCase A]"
  1847.         append text [htmlWrapTag [htmlSetCase HREF=]\"$url\">]
  1848.         set closing [htmlCloseElem A]
  1849.         if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append closing $elecStopMarker}
  1850.     }
  1851.     append text $htmlCurSel
  1852.     set currpos [expr [getPos] + [string length $text]]
  1853.     append text $closing
  1854.     if {$htmlIsSel} { deleteSelection }
  1855.     insertText $text
  1856.     if {!$htmlIsSel} {
  1857.         goto $currpos
  1858.     }
  1859. }
  1860.  
  1861.  
  1862. # closeHook
  1863. proc htmlCloseHook {name} {
  1864.     global htmlHomePageWinList
  1865.     set tmp ""
  1866.     foreach win $htmlHomePageWinList {
  1867.         if {$name != [lindex $win 1]} {
  1868.             lappend tmp $win
  1869.         }
  1870.     }
  1871.     set htmlHomePageWinList $tmp
  1872. }
  1873.  
  1874. # deactivateHook
  1875. proc htmldeactivateHook {name} {
  1876.     global htmlHPwinPositions
  1877.     set winSize [getGeometry]
  1878.     # When closing size is {0 0 0 0}
  1879.     if {$winSize == {0 0 0 0}} {return}
  1880.     set htmlHPwinPositions([string trim [getText 0 [nextLineStart 0]]]) $winSize
  1881. }
  1882.  
  1883. namespace eval Home {}
  1884. proc Home::DblClick {from to} {htmlHomeReturn}
  1885.  
  1886. foreach __char {a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 . _ -} {
  1887.     bind '$__char' "htmlSearchInHPwin $__char" Home
  1888. }
  1889. unset __char
  1890.  
  1891. bind '\r' htmlHomeReturn Home
  1892. bind down <c> htmlHomeReturn Home
  1893. bind enter htmlHomeReturn Home
  1894. bind down     downBrowse Home
  1895. bind up     upBrowse Home
  1896. bind '\r' <c> htmlHpWinBack Home
  1897. bind enter <c> htmlHpWinBack Home
  1898. bind up <c> htmlHpWinBack Home
  1899. bind 'r' <c> htmlRefreshHpWin Home
  1900. bind 'c' <cs> htmlCopyURL Home
  1901.  
  1902.  
  1903. #===============================================================================
  1904. # Validation
  1905. #===============================================================================
  1906.  
  1907. proc htmlFindUnbalancedTags {} {
  1908.     global tileLeft tileTop tileWidth errorHeight
  1909.     
  1910.     message "Searching for unbalanced tags…"
  1911.     set fil [stripNameCount [lindex [winNames -f] 0]]
  1912.     # These may not have an closing tag.
  1913.     set empty {!DOCTYPE BASEFONT BR AREA LINK IMG PARAM HR INPUT ISINDEX BASE META}
  1914.     lappend empty  COL FRAME SPACER WBR EMBED BGSOUND KEYGEN
  1915.     # These have an optional closing tag.
  1916.     set closingOptional {P DT DD LI OPTION TR TD TH HEAD BODY HTML WINDOW}
  1917.     lappend closingOptional COLGROUP THEAD TBODY TFOOT
  1918.     # These have an optional opening tag.
  1919.     set openingOptional {HTML HEAD BODY}
  1920.     lappend openingOptional TBODY
  1921.     
  1922.     set tagStack WINDOW
  1923.     set pos 0
  1924.     while {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!--|<[^<>]+>} $pos} res]} {
  1925.         set tagstart [lindex $res 0]
  1926.         set tagend   [lindex $res 1]
  1927.         set tagtxt [getText $tagstart $tagend]
  1928.         if {$tagtxt == "<!--"} {
  1929.             # Comment
  1930.             if {![catch {search -s -f 1 -r 0 -m 0 -- {-->} $tagstart} res]} {
  1931.                 set pos [lindex $res 1]
  1932.             } else {
  1933.                 set pos [maxPos]
  1934.             }
  1935.             continue
  1936.         }
  1937.         # get element name
  1938.         if {![regexp {<[ \t\r]*([^ \t\r]+).*>} $tagtxt tmp tag]} {
  1939.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Empty <>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  1940.             set pos $tagend
  1941.             continue
  1942.         }
  1943.         set tag [string toupper $tag]
  1944.         # is this a closing tag?
  1945.         if {[string index $tag 0] == "/"} {
  1946.             set tag [string range $tag 1 end]
  1947.             if {[lsearch -exact $empty $tag] >= 0} {
  1948.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag may mot have a closing tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  1949.             } elseif {[lsearch -exact $tagStack $tag] < 0 && [lsearch -exact $openingOptional $tag] < 0} {
  1950.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Closing $tag without a matching opening tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  1951.             } else {
  1952.                 for {set i 0} {$i < [llength $tagStack]} {incr i} {
  1953.                     if {[set this [lindex $tagStack $i]] != $tag} {
  1954.                         if {[lsearch -exact $closingOptional $this] < 0} {
  1955.                             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this must be closed before $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  1956.                         }
  1957.                     } else {
  1958.                         break
  1959.                     }
  1960.                 }
  1961.                 set tagStack [lrange $tagStack [expr $i + 1 ] end]
  1962.             }
  1963.         } else {
  1964.             # opening tag
  1965.             if {[lsearch -exact $empty $tag] < 0} {
  1966.                 set tagStack [concat $tag $tagStack]
  1967.             }
  1968.         }
  1969.         set pos $tagend
  1970.     }
  1971.     # check if there are unclosed tags.
  1972.     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  1973.         if {[lsearch -exact $closingOptional [set this [lindex $tagStack $i]]] < 0} {
  1974.             append errtxt "Line [lindex [posToRowCol [maxPos]] 0] : $this must be closed before HTML.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  1975.         }
  1976.     }
  1977.     if {[info exists errtxt]} {
  1978.         new -n "* Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  1979.         insertText "Errors:  (<uparrow> and <downarrow> to browse, <return> to go to file)\r\r"
  1980.         insertText $errtxt
  1981.         htmlSetWin
  1982.     } else {
  1983.         alertnote "No unbalanced tags found!"
  1984.     }
  1985.  
  1986. }
  1987.  
  1988. proc htmlCheckTags {} {
  1989.     global tileLeft tileTop tileWidth errorHeight
  1990.     
  1991.     message "Checking tags…"
  1992.     set fil [stripNameCount [lindex [winNames -f] 0]]
  1993.     
  1994.     htmlCheckConfig
  1995.     
  1996.     set doctype [htmlFindDoctype]
  1997.     # Remove some things depending on the doctype.
  1998.     if {$doctype == "transitional" || $doctype == "strict"} {
  1999.         regsub "FRAME" $empty "" empty
  2000.         unset mayContain(FRAMESET)
  2001.     }
  2002.     if {$doctype == "strict"} {
  2003.         foreach xxx {APPLET FONT CENTER DIR MENU STRIKE S U} {
  2004.             unset mayContain($xxx)
  2005.         }
  2006.         regsub -all "BASEFONT|ISINDEX" $empty "" empty
  2007.     }
  2008.     if {$doctype == "frameset"} {
  2009.         set mayContain(HTML) {HEAD FRAMESET}
  2010.     }
  2011.     
  2012.     # Validate
  2013.     set headHasBeen 0
  2014.     set bodyHasBeen 0
  2015.     set htmlHasBeen 0
  2016.     set tagStack WINDOW
  2017.     set currentTag WINDOW
  2018.     set pos 0
  2019.     while {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!--|<[^<>]+>} $pos} res]} {
  2020.         set tagstart [lindex $res 0]
  2021.         set tagend   [lindex $res 1]
  2022.         set tagtxt [getText $tagstart $tagend]
  2023.         # get element name
  2024.         if {$tagtxt != "!--" && ![regexp {<[ \t\r]*([^ \t\r>]+)} $tagtxt tmp tag]} {
  2025.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Empty <>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2026.             set pos $tagend
  2027.             continue
  2028.         } else {
  2029.             set tag [string toupper $tag]
  2030.         }
  2031.         if {$tagstart > $pos} {
  2032.             set prevTxt [getText $pos [expr $tagstart -1]]
  2033.         } else {
  2034.             set prevTxt ""
  2035.         }
  2036.         # check for unmatched < or > in text.
  2037.         if {[regexp {<} $prevTxt]} {
  2038.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Unmatched <.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2039.         }
  2040.         if {[regexp {>} $prevTxt]} {
  2041.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Unmatched >.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2042.         }
  2043.         
  2044.         # check for text if current element may not contain text.
  2045.         set back 0
  2046.         if {[lsearch -exact $mayContain($currentTag) text] < 0 &&
  2047.         ![regexp {^[ \t\r]*$} $prevTxt ]} {
  2048.             # back up and insert BODY if needed
  2049.             if {!$bodyHasBeen && [lsearch -exact $tagStack BODY] < 0 &&
  2050.             [lsearch -exact $tagStack FRAMESET] < 0} {
  2051.                 set tagend $pos
  2052.                 set tag BODY
  2053.                 set back 1
  2054.             } else {
  2055.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $currentTag may not contain text.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2056.             }
  2057.         }
  2058.         if {!$back && $tagtxt == "<!--"} {
  2059.             # Comment
  2060.             if {![catch {search -s -f 1 -r 0 -m 0 -- {-->} $tagstart} res]} {
  2061.                 set pos [lindex $res 1]
  2062.             } else {
  2063.                 set pos [maxPos]
  2064.             }
  2065.             continue
  2066.         }
  2067.         # Silently ignore !DOCTYPE
  2068.         if {$tag == "!DOCTYPE"} {
  2069.             set pos $tagend
  2070.             continue
  2071.         }
  2072.         # back up and insert HEAD if needed.
  2073.         if {!$headHasBeen && [lsearch -exact $mayContain(HEAD) $tag] >= 0} {
  2074.             set tagend $pos
  2075.             set tag HEAD
  2076.         }
  2077.         # back up and insert TBODY if needed
  2078.         if {$currentTag == "TABLE" && [lsearch -exact $mayContain(TABLE) $tag] < 0} {
  2079.             set tagend $pos
  2080.             set tag TBODY
  2081.         }
  2082.         set xtag [string trimleft $tag /]
  2083.         # insert BODY if tag can't be in HEAD or HEAD is closed.
  2084.         if {!$bodyHasBeen && ([lsearch -exact $mayContain(HEAD) $xtag] < 0 ||
  2085.         [lsearch -exact $tagStack HEAD] < 0) &&
  2086.         $xtag != "HTML" && $xtag != "HEAD" && $xtag != "BODY" && 
  2087.         !($xtag == "FRAMESET" || [lsearch -exact $tagStack FRAMESET] >= 0)} {
  2088.             set tagend $pos
  2089.             set tag BODY
  2090.         }
  2091.         # insert HTML if not done
  2092.         if {!$htmlHasBeen && $tag != "HTML"} {
  2093.             set tagend $pos
  2094.             set tag HTML
  2095.         }
  2096.         
  2097.         # check if there's anything after </HTML>
  2098.         if {$tag == "/HTML"} {
  2099.             if {![regexp {^([ \t\r\n]*|([ \t\r\n]*<!--[^>]*-->)*[ \t\r\n]*)$} [getText $tagend [maxPos]]]} {
  2100.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Text after </HTML>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2101.             }
  2102.             break
  2103.         }
  2104.         # is this a closing tag?
  2105.         if {[string index $tag 0] == "/"} {
  2106.             set tag [string range $tag 1 end]
  2107.             if {![info exists mayContain($tag)]} {
  2108.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag is unknown.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2109.             } else {
  2110.                 if {$tag == "HEAD" || $tag == "BODY"} {set headHasBeen 1}
  2111.                 if {$tag == "BODY"} {set bodyHasBeen 1}
  2112.                 if {[lsearch -exact $empty $tag] >= 0} {
  2113.                     append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag may mot have a closing tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2114.                 } elseif {[lsearch -exact $tagStack $tag] < 0} {
  2115.                     append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Closing $tag without a matching opening tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2116.                 } else {
  2117.                     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2118.                         if {[set this [lindex $tagStack $i]] != $tag} {
  2119.                             if {[lsearch -exact $closingOptional $this] < 0} {
  2120.                                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this must be closed before $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2121.                             }
  2122.                         } else {
  2123.                             break
  2124.                         }
  2125.                     }
  2126.                     set tagStack [lrange $tagStack [expr $i + 1 ] end]
  2127.                     set currentTag [lindex $tagStack 0]
  2128.                 }
  2129.             }
  2130.         } else {
  2131.             # opening tag
  2132.             if {$headHasBeen && $tag == "HEAD"} {
  2133.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple HEAD tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2134.             } 
  2135.             if {$bodyHasBeen && $tag == "BODY" && !($currentTag == "NOFRAMES" && $doctype == "frameset")} {
  2136.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple BODY tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2137.             }
  2138.             if {$htmlHasBeen && $tag == "HTML"} {
  2139.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple HTML tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2140.             }
  2141.             if {$tag == "HEAD" || $tag == "BODY"} {set headHasBeen 1}
  2142.             if {$tag == "BODY"} {set bodyHasBeen 1}
  2143.             if {$tag == "HTML"} {set htmlHasBeen 1}
  2144.             # unknown tag?
  2145.             if {[set em [lsearch -exact $empty $tag]] < 0 && ![info exists mayContain($tag)]} {
  2146.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag is unknown.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2147.             } else {
  2148.                 # implicitely close those which may not contain $tag.
  2149.                 for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2150.                     set this [lindex $tagStack $i]
  2151.                     if {[lsearch -exact $mayContain($this) $tag] < 0} {
  2152.                         # Silently close those with an optional closing tag except BODY and HTML.
  2153.                         if {[lsearch -exact $closingOptional $this] < 0 || $this == "BODY" || $this == "HTML"} {
  2154.                             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this may not contain $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2155.                             break
  2156.                         }
  2157.                     } else {
  2158.                         break
  2159.                     }
  2160.                 }
  2161.                 if {$em < 0} {
  2162.                     set tagStack [concat $tag [lrange $tagStack $i end]]
  2163.                     set currentTag $tag
  2164.                 } else {
  2165.                     set tagStack [lrange $tagStack $i end]
  2166.                 }
  2167.             }
  2168.         }
  2169.         set pos $tagend
  2170.     }
  2171.     # check if there are unclosed tags.
  2172.     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2173.         if {[lsearch -exact $closingOptional [set this [lindex $tagStack $i]]] < 0} {
  2174.             append errtxt "Line [lindex [posToRowCol [maxPos]] 0] : $this must be closed before HTML.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2175.         }
  2176.     }
  2177.     if {[info exists errtxt]} {
  2178.         new -n "* Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  2179.         insertText "Errors:  (<uparrow> and <downarrow> to browse, <return> to go to line)\r\r"
  2180.         insertText $errtxt
  2181.         htmlSetWin
  2182.     } else {
  2183.         alertnote "No syntax errors found! (Attributes have not been checked.)"
  2184.     }
  2185. }
  2186.